home *** CD-ROM | disk | FTP | other *** search
/ Tiger Disk 12 / Tiger_Disk_012_19xx_Tiger-Crew-Disk_de_Side_B.d64 / disk checker ii (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  4KB  |  134 lines

  1. 90 poke53280,11:poke53281,0:print"[153][147]"
  2. 100 print"disk checker[146]  - jim butterfield":poke1170,48
  3. 110 dim a(255),c%(77,28),d%(1),n$(224),t%(224,1),s%(224,1),l%(224),r%(77)
  4. 120 d%(0)=58:d%(1)=42:z$=chr$(0)
  5. 130 data 1,17,20,24,19,30,17,35,16,0
  6. 140 data 65,17,20,24,18,30,17,35,16,0
  7. 150 data 67,39,28,53,26,64,24,77,22,0
  8. 160 b$=chr$(17):input"drive#(0-1)";d$:b$=chr$(3)
  9. 170 ifd$<>"0"andd$<>"1"goto160
  10. 180 open15,8,15,"i"+d$:gosub3020
  11. 190 open3,8,3,"$"+d$:gosub3020
  12. 200 a0=1:get#3,a$:a=asc(a$+z$)
  13. 210 reada1:ifa=a1goto250
  14. 220 f%=f%+1:iff%=3goto290
  15. 230 reada1:ifa1=0goto210
  16. 240 goto230
  17. 250 reada1:ifa1=0goto270
  18. 260 readb1:forj=a0toa1:r%(j)=b1:nextj:a0=j:goto250
  19. 270 ifa=1ora=65thend1=1:t9=35:s9=3:d9=18
  20. 280 ifa=67thend1=257:t9=77:s9=4:d9=39
  21. 290 ift9=0thenclose3:print:print"?? disk not recognized ??[153][146]":stop
  22. 300 rem****get and print bam****
  23. 310 print"[147]     free block map"
  24. 315 print:print"     : =used  * =free":print
  25. 320 forj=1tod1:get#3,a$:nextj
  26. 330 forj=1tot9:t1=0
  27. 340 ifj=51thenget#3,a$,a$,a$,a$
  28. 350 get#3,a$:c=asc(a$+z$)
  29. 360 printright$(" "+str$(j),2);" ";
  30. 370 k1=0:fork=0tos9-1:get#3,a$:a=asc(a$+z$)
  31. 380 forl=0to7:a%=a/2:d1=a-a%*2:ifk1<=r%(j)thenc%(j,k1)=d1:printchr$(d%(d1));
  32. 390 a=a%:t1=t1+d1:k1=k1+1:nextl,k:print
  33. 400 ift1<>cthenprint"?";
  34. 410 nextj
  35. 420 rem    do specific job
  36. 430 print"[147]":close3:print "    choose --"
  37. 440 print "1. check all files"
  38. 450 print "2. check for bad spots"
  39. 460 print "3. recover scratched file"
  40. 470 print "  your choice? ";
  41. 480 getx$:ifx$=""goto480
  42. 490 x=asc(x$)-48:ifx<1orx>3goto480
  43. 500 printx$:open2,8,2,"#0":gosub3020
  44. 510 onxgoto520,790,890
  45. 520 rem     check files
  46. 530 t=d9:s=1
  47. 540 gosub2000
  48. 550 ford=2to255step32:ifa(d)<128goto590
  49. 560 d3=d3+1:t%(d3,0)=a(d+1):s%(d3,0)=a(d+2):l%(d3)=a(d+28)+a(d+29)*256
  50. 570 ifa(d)=132thent%(d3,1)=a(d+19):s%(d3,1)=a(d+20)
  51. 580 n$="":fork=d+3tod+18:n$=n$+chr$(a(k)):nextk:n$(d3)=n$
  52. 590 nextd
  53. 600 t=a(0):s=a(1):ift=d9goto540
  54. 610 ford=1tod3:l%=0
  55. 620 printn$(d);
  56. 630 t=t%(d,0):s=s%(d,0)
  57. 640 ift>t9ors<0thent=0
  58. 650 ift<1ors>r%(t)thenprint" bad chain":goto770
  59. 660 ifc%(t,s)=1thenprint" unallocated blocks":goto770
  60. 670 ifc%(t,s)>1thenprint" conflict ";n$(c%(t,s)-1):goto770
  61. 680 c%(t,s)=1+d
  62. 690 gosub3000
  63. 700 l%=l%+1
  64. 710 forj=0to1:print#15,"m-r";chr$(j);b$:get#15,a$
  65. 720 a(j)=asc(a$+z$):nextj
  66. 730 t4=t:s4=s:t=a(0):s=a(1):ift<>0ande=0goto640
  67. 740 t=t%(d,1):s=s%(d,1):t%(d,1)=0:ift<>0goto640
  68. 750 ifl%<>l%(d)thenprint" incorrect block count":goto770
  69. 760 print:print"[145]                       [145]"
  70. 770 nextd
  71. 780 print:printd3;"files":goto1270
  72. 790 rem   scan sectors
  73. 800 iff%=0thenprint"sorry .. can't do it":goto1270
  74. 810 fort=1tot9:print"track";t
  75. 820 fors=0tor%(t)
  76. 830 print"[145] sect";s
  77. 840 gosub3000
  78. 850 nexts
  79. 860 print"[145]                    [145]"
  80. 870 nextt
  81. 880 print"disk ok":goto1270
  82. 890 rem    unscratch
  83. 900 k=0:print"i will look for discarded files..."
  84. 910 t=d9:s=1
  85. 920 gosub2000
  86. 930 ford=2to255step32:ifa(d)<>0ora(d+1)=0goto980
  87. 940 ifk=0thenprint"do you want to recover:"
  88. 950 getx$:fork=d+3tod+18:printchr$(a(k));:nextk:print"? ";
  89. 960 getx$:ifx$<>"y"andx$<>"n"goto960
  90. 970 printx$:ifx$="y"goto1010
  91. 980 nextd
  92. 990 t=a(0):s=a(1):ift=d9goto920
  93. 1000 print"that's all ":goto1270
  94. 1010 t6=t:s6=s:d6=d:t=a(d+1):s=a(d+2):l%(0)=a(d+28)+a(d+29)*256:l%=0
  95. 1020 getx$:print"is this file:"
  96. 1030 print" 1. sequential"
  97. 1040 print" 2. program"
  98. 1050 print" 3. usr"
  99. 1060 ifa(d+19)=0goto1080
  100. 1070 print" 4. relative"
  101. 1080 print"  which number? ";
  102. 1090 getx$:ifx$=""goto1090
  103. 1100 x=asc(x$)-48:ifx<1orx>4goto1090
  104. 1110 printx$:x=x+128
  105. 1120 ifx=132thent%(0,1)=a(d+19):s%(0,1)=a(d+20):ift%(0,1)=0goto1020
  106. 1130 ift>t9ors<0thent=0
  107. 1140 ift<1ors>r%(t)thenprint" bad chain!":goto1260
  108. 1150 ifc%(t,s)=0thenprint" allocated blocks!":goto1260
  109. 1160 gosub3000:l%=l%+1
  110. 1170 forj=0to1:print#15,"m-r";chr$(j);b$:get#15,a$
  111. 1180 a(j)=asc(a$+z$):nextj
  112. 1190 t4=t:s4=s:t=a(0):s=a(1):ift<>0goto1130
  113. 1200 t=t%(0,1):s=s%(0,1):t%(0,1)=0:ift<>0goto1130
  114. 1210 ifl%<>l%(0)thenprint" incorrect block count!":goto1260
  115. 1220 t=t6:s=s6:d=d6
  116. 1230 gosub3000
  117. 1240 print#15,"m-w";chr$(d);b$;chr$(1);chr$(x)
  118. 1250 print#15,"u2:2,";d$;t;s:gosub3020:goto1300
  119. 1260 print "sorry - it won't work"
  120. 1270 close2
  121. 1280 input"** got time to validate disk";x$
  122. 1290 ifasc(x$)=78thenend
  123. 1300 close2:print#15,"v";d$:end
  124. 2000 rem    grab full disk block
  125. 2010 gosub3000
  126. 2020 forj=0to255:print#15,"m-r";chr$(j);b$:get#15,a$
  127. 2030 a(j)=asc(a$+z$):nextj:return
  128. 3000 rem    read block
  129. 3010 print#15,"b-r:2,";d$;t;s
  130. 3020 rem   get error status
  131. 3030 input#15,e,e$,e1,e2
  132. 3040 ife<>0thenprint"[158]disk error:[146][153]"e;e$,e1;e2
  133. 3050 return
  134.